perm filename TRNSP.F4[PAG,LCS]8 blob sn#575390 filedate 1981-03-26 generic text, type T, neo UTF8
C**** TRNSP, RVRS, BMGHT, CUES  ***************
	SUBROUTINE TRNSP
	COMMON /MIN/J,R,RT,XRT,RX
	COMMON /PX/KPN(1) /Q/Q(1) /XRN/RN(1) 
	COMMON/STF/RSTFAC(0/7),RSTJ2 /IPG/IPG,JPG,BRACK(8),
	1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(0/7)
 	1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,IRV,ITR
	COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
	1,LC,LPG,MPG,ZCLEF,SIG,LB,SPG,MTR1,MTR2
	1 /LLL/LEND,NO1,NI,NO3,XSIG /RSIG/RSIG(0/7)
	1 /TRAN/RTR(17),KTR(17)
	DATA RTR/5.,5.,4.,4.,3., 2.,2.,1.,1.,1., -1.,-1.,-2.,-2.,-3.
	1 ,-4.,8./,KTR/3,-4,1,-6,-1, 4,-3,2,-5,0, 5,-2,3,-4,1, -1,2/

	IOCT=0
	RXT=99.
	KW=0
	IF(ITR.LE.17)GO TO 1002
	IADD=0
	RT=7
C OCTAVE ↑ = 19,  - = 18
	IF(ITR.EQ.18)RT=-RT  
	IOCT=-1
	GO TO 199
1002	IF(SIG.NE.99.)GO TO 199
C  FOUND KSIG, SO DON'T DO THE REST
	IF(XSIG.NE.0)GO TO 2002
	RT=0
	IF(ITR.EQ.0)RETURN
	RT=RTR(ITR)
C  EEb,EE,F-,F#-,G,  Ab,A,Bb,B,DMY,  Db,D,Eb,E,F,G↑  BBb, 8-, 8↑
41	NSIG=-1
	IF(RSIG(KW).NE.99)GO TO 699
C  ASSUMES KSIG DESIRED IF ONE THERE ALREADY.
	IF(ZSIG(XSIG).NE.'Y')GO TO 199
C FUNCTION ZSIG ASKS 'ADD KEY SIG?'
699	NSIG=0
	XSIG=99

C  ***** NEXT FOR KEY SIG. ********
	IADD=KTR(ITR)
C  EEb,EE,F-,F#-,G,  Ab,A,Bb,B,DMY,  Db,D,Eb,E,F,G↑  BBb, 8-, 8↑
2002	K=0
2003	R=0
	RZ=RSIG(K)
	IF(RZ.NE.99)R=RZ
	R=IADD+R
	IF(R.EQ.0)GO TO 799
	A=ABS(R)
	IF(A.LT.8.OR.A.GE.100)GO TO 899
C IF IMPOSSIBLE KSIG, DO ENHARMONIC SHIFT (NATURALS KSIG IS OK)
	IF(R.LT.0)GO TO 1899
	R=R-12
	ITR=9
	RT=RT+1
	GO TO 899
1899	R=R+12
	ITR=11
	RT=RT-1
899	IF(IPG.GT.0)GO TO 799
C SKIP IF TRNSP ONLY.
	IF(RZ.NE.99)GO TO 799
	SIG=0
	CALL STAFF(4.,17.,4.0*RSTJ2,0,R,CLEF,0,0,0,0,0,0)
799	RSIG(K)=R
	K=K+1
	IF(K.LT.JPG)GO TO 2003
199	K=1
	SLUR=0
	PRX=99
	MS=200
	SN=KW
599	X=CODEN(KPN,K,Q,J)
	IF(X.EQ.4)GO TO 2
	IF(Q(J+2).NE.SN)GO TO 100
CHECK FOR STAFF NUM.
	IF(X.EQ.1)GO TO 1
	IF(X.NE.3)GO TO 20
	CLEF=Q(J+5)
	IF(Q(J).LT.3)CLEF=0
	IF(ITR.NE.17.AND.ITR.NE.3)GO TO 100
C NEXT FOR HORN IN F CLEF CHANGES**** NOW ONLY BS.CLAR 10/79
C  NEXT FOR BASS CL. CLEF CHANGES.
21	IF(CLEF.NE.0)Q(J+5)=0
	IF(RXT.NE.99.)RXT=RT
C RESET DISPLACEMENT WHEN PART IS IN TREBLE CLEF.
	IF(Q(J+4).LT.100.)GO TO 100
	CALL SHRNK(K,LEND)
C  MAKE IT INVISIBLE IF IT WAS MINI.
	GO TO 599
2	BAR=-1
	MS=200
	GO TO 100
20	IF(X.NE.17)GO TO 12
C  HOW ABOUT CHANGE TO NO SIG?  OK, CODE =99
	R=Q(J+5)
C KSIG NUM.
	A=R+IADD
CHANGED TO A
	IF(ABS(A).LT.8)GO TO 423
C AVOIDS IMPOSSIBLE KSIG, DOES ENHARMONIC CHANGE.
	IF(A.LT.0)GO TO 223
	ITR=9
	A=A-12
	RT=RT+1
	GO TO 423
223	A=A+12
	ITR=11
	RT=RT-1
423	IF(A.NE.0)GO TO 23
	M=Q(J)+3
C THIS WILL DELETE KSIG
	ITOT=KPN(LEND+1)-1
323	ITOT=ITOT-M
	KL=ITOT-J+1
	CALL RLOOP(Q(J),Q(J+M),KL)
	DO 334 J=K,LEND
334	KPN(J)=KPN(J+1)-M
	LEND=LEND-1
	NI=NI-1
C NI IS I IN WRTPAG.
	K=K-1
	GO TO 100
23	Q(J+5)=A
	IF(ITR.NE.17.AND.ITR.NE.3)GO TO 523
	IF(CLEF.EQ.1.)Q(J+6)=0
C PUTS HORN AND BS.CLAR BASS CLEF KEY SIG UP TO TREB. POSITION
523	NSIG=0
12	IF(X.NE.5)GO TO 123
	SLUR=Q(J+6)
	GO TO 121
C  SAVES RIGHT POS. OF SLUR
123	IF(X.NE.6)GO TO 100
121  	A=RT 
C  FOR BEAMS AND SLURS
	IF(ITR.NE.17.AND.ITR.NE.3)GO TO 124
C A=8=BS.CL. =4=HRN   MOVES BEAMS AND SLURS IF CLEF CHANGE
122	IF(CLEF.EQ.1)A=A-12
C BASS CLEF → TREBLE
124	Q(J+4)=Q(J+4)+A
	Q(J+5)=Q(J+5)+A
C ASSUMES NO CLEF CHANGE BETWEEN END POINTS OF SLUR OR BEAM.
	GO TO 100

1	IF(Q(J).GE.7.AND.Q(J+9).LT.0)GO TO 100
	CALL MINCVT
C IF P9 IS NEG. IT'S A NOTE WITHOUT LEDGER LINES.  IGNORE IT.
C3/81 	R=Q(J+4)
C3/81 	IF(R.LT.80.)GO TO 110
C3/81 	IF(R.GE.100.)GO TO 110
C3/81 C NOW WE MUST CONVERT THE CODE FOR A MINI-NOTE
C3/81 	R=R-200.
C3/81 C e.g. 97 IS CHANGED TO -103, A MINI AT LEVEL -3.
C3/81 C (BUT WHAT ABOUT -97?)
C3/81 	Q(J+4)=R
C3/81 110	XRT=RT
C3/81 	IF(Q(J).LT.6)GO TO 111
C3/81 C SKIP IF NO STEM INFO
C3/81 	RX=Q(J+8)
C3/81 	IF(RX.GT.999.0)GO TO 111
C3/81 	IF(RX.EQ.999.0)RX=0     
C3/81 	RX=RX+RT
C3/81 	IF(RX.LT.0)RX=0
C3/81 C RESET STEM LENGTH.  NEVER SHORTER THAN 0 (NORMAL).
C3/81 	Q(J+8)=RX
111	IF(IOCT.LT.0)GO TO 4
C  IOCT=-1 FOR OCT+ OR OCT- 
	RX=AMOD(R,100.0)
	RZ=AMOD(RX,7.0)
C  THE NOTE NUM
	IF(RZ.LT.0)RZ=RZ+7
C  PUTS IT IN 0-6 RANGE FOR ACCI CHANGE SECTION.
	R5=Q(J+5)
	A=AMOD(R5,10.0)
C  THE ACCI
	RN(MS)=A
	RN(MS+1)=RX
C  SAVE FOR REPEATS
	MS=MS+2
	CHNAT=3
	IF(MS.LT.203)GO TO 205
	N=MS-3
200	IF(RX.NE.RN(N))GO TO 201
	IF(A.EQ.0)GO TO 444
C  NOW WE'VE FOUND THE SAME NOTE WITH NO ACCI IN SAME MEAS.
	GO TO 203
201	N=N-2
	IF(N.GE.200)GO TO 200
205	IF(NSIG.LT.0)CHNAT=0
203	ADD=A
C  THE CHANGE IN ACCI
	IF(PRX.NE.RX)GO TO 44
C IF PREV ACCI AND NT ARE SAME, SKIP OVER.
	IF(A.NE.0)GO TO 44
C NOW SAME NOTE, NO ACCI
	IF(ABS(SLUR-Q(J+3)).GT.3)GO TO 44
C  FOUND CONNECTING TIE
C THIS ↑↑↑↑ ALWAYS PUTS ACCI AFTER A BAR -- EVEN WITH TIE------
C OR SET MS BACK TO 200 WHEN TIE IS PRESENT.  THIS WILL
CAUSE LATER SAME NOTE TO HAVE ACCI (I HOPE.)
	IF(BAR.LT.0)MS=200
	IF(A.NE.0)GO TO 203
	GO TO 444
44	IF(NSIG.LT.0)GO TO 440
CCC	IF(ITR.GE.17)GO TO 69
	IF(A.EQ.0)GO TO 444
C  ONLY CHECKS ON NOTES WITH NO ACCI
	IF(ITR.GE.18)GO TO 444
	

440	IF(CLEF.NE.1)GO TO 69
	RZ=RZ-5 
	IF(RZ.LT.0)RZ=RZ+7
CC69	GO TO (63,52,53,54,55, 56,57,58,59,440, 61,62,63,52,53,55
69	N=A+1
	GO TO (63,52,64,54,55, 56,57,58,59,440, 61,62,63,52,53,55
	1 ,64),ITR
C  EEb,EE,F↓,F#↓,G,  Ab,A,Bb,B,DMY,  Db,D,Eb,E,F,G↑  BBb
54	IF(RZ.EQ.3)GO TO 101
59	IF(RZ.EQ.6)GO TO 101
52	IF(RZ.EQ.2)GO TO 101
57	IF(RZ.EQ.5)GO TO 101
C  FOR "A".  FINDS C,F AND G.
62	IF(RZ.EQ.1)GO TO 101
55	IF(RZ.EQ.4)GO TO 101
C  "G"   F→Bb, F#→B NAT.
	GO TO 4
61	IF(RZ.EQ.5)GO TO 7
56	IF(RZ.EQ.2)GO TO 7
63	IF(RZ.EQ.6)GO TO 7
58	IF(RZ.EQ.3)GO TO 7
53	IF(RZ.NE.0)GO TO 4
	
7	GO TO(402,30,405,402,401)N
30	ADD=CHNAT
C  MAKE IT NAT. IF NEEDED
3	Q(J+5)=R5-A+ADD
4	PRX=RX
C  REAL NOTE LEVEL
	Q(J+4)=R+XRT
	BAR=0
	RXT=XRT
100	IF(K.GE.LEND)GO TO 499
	K=K+1
	GO TO 599


C NEXT FOR BSCLAR.---ADD OTHERS HERE!!!
64	IF(CLEF.EQ.1)XRT=XRT-12
	IF(ITR.EQ.3)GO TO 53
	GO TO 58
444	IF(ITR.NE.17.AND.ITR.NE.3)GO TO 544
	IF(CLEF.EQ.1.)XRT=XRT-12
C FOR HORN AND BS.CLAR CHANGE FROM BASS TO TREB. CLEF
544	IF(RXT.NE.99.)XRT=RXT
C THIS FOR BS.CL. AND HRN. REPEATED NOTES.
	GO TO 4

101	GO TO(401,404,30,401,404,402)N
C  WON'T HANDLE Gbb→Ab
404	ADD=4
	GO TO 3
401	ADD=1
	GO TO 3

402	ADD=2
	GO TO 3
405	ADD=5
	GO TO 3
499	KW=KW+1
	IF(KW.LT.JPG)GO TO 199
	CALL RVRS(LEND)
C  TO REVERSE STEMS, BEAMS AND SLURS
	END



	SUBROUTINE RVRS(LEND)
	COMMON /PX/KPN(1) /Q/Q(1) /XRN/RN(1)
 	1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,IRV,ITR
	1 /IPG/IPG,JPG,BRA(8),RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(8)
	DATA RSTEM/6.5/
	KW=0
C TRNS ↓ + STEM ↑ = NO CHNG, TRNS ↑ +STEM ↓ = NO CHNG
100	K=1
	SN=KW
	DO 30 N=1,LEND
	IF(CODEN(KPN,N,Q,J).NE.1)GO TO 30
C LOOK FOR NOTES WITH STEM BUT NO RHYTH. VALUE
	IF(Q(J+2).NE.SN)GO TO 30
C ON THIS STAFF?
	IF(Q(J).LT.7)GO TO 31
	IF(Q(J+9).NE.0)GO TO 30
31	IF(Q(J+5).GE.10)GO TO 102
C FOUND A 0 RHYTHM WITH A STEM - IGNORE THIS STAFF
30	CONTINUE

1	R=CODEN(KPN,K,Q,J)
	IF(Q(J+2).NE.SN)GO TO 10
CHECK ON STAFF NUM.
	IF(R.NE.1)GO TO 2
C  JUMP IF NOT A NOTE
CHECKS STEM DIR. AND TRNS DIR.
CCC	IF(Q(J+5).LT.10)GO TO 10
	IF(Q(J+5).LT.10)GO TO 202
C  JUMP IF NO STEM ON IT
	IF(Q(J+8).GT.999.)GO TO 202
	B=Q(J)
	IF(B.GT.7.AND.Q(J+10).NE.0)GO TO 202
C  JUMP IF GRACE NOTE (P8=1000 OR P10=-1) OR ON ANOTHER STAFF.
	IF(B.GT.6.AND.Q(J+9).LT.0)GO TO 202
C SKIP NOTES WITH NO LEDGER LINES
	KK=K+1
3	IF(KK.GT.LEND)GO TO 102
	RR=CODEN(KPN,KK,Q,JJ)
	IF(Q(JJ+2).EQ.SN)GO TO 101
	GO TO 7
101	IF(RR.NE.1)GO TO 5
C  JUMP IF NOT A NOTE
	IF(Q(JJ+5).GE.10)GO TO 6
C SKIP CHORD NOTES (NO STEM)
7	KK=KK+1
	GO TO 3
C DID NOT FIND BEAM NEARBY
6	RZ=AMOD(Q(J+4),100.0)
C CAN BE PROBLEM HERE (SEE START OF SUBR. MINCVT)
	N=J+5
	A=10
	IF(RZ.GE.7)GO TO 60
	IF(Q(N).LT.20)GO TO 10
C NOW STEM SHOULD BE DOWN IF WITHOUT BEAM OR 1ST NT UNDER BEAM.
	A=-A
	GO TO 15
60	IF(Q(N).GE.20)GO TO 10
C  THERE MUST BE A BETTER WAY!
15	Q(N)=Q(N)+A
	GO TO 10

CCC5	IF(RR.NE.6)GO TO 6
5	IF(RR.EQ.6)GO TO 20
	IF(Q(JJ+3).NE.Q(J+3))GO TO 6
CATCHES OTHER THINGS AT EXACTLY SAME POS. AS NOTE AND BEAM.
	KK=KK+1
	GO TO 3

20	B=Q(JJ+4)
	C=Q(JJ+5)
	D=(B+C)/2.
	IF(RR.EQ.5)GO TO 9
	IF(RR.NE.6)GO TO 10

	CALL BMHGT(B,C,JJ)
120	B=Q(JJ+6)+.5
C  SAVES RANGE OF BEAM +1.
	IF(Q(JJ+7).GE.20)GO TO 11
C  NOW STEMS ARE UP
	IF(D.LT.RSTEM)GO TO 12
C JUMP TO 12 IF ALL OK
	IF(AVERG(K,JJ,LEND).EQ.0)GO TO 12
C JUMP IF NOTE LEVELS DO NOT CALL FOR REVERSED STEMS
	JSTM=0 
C SAVE FOR REVERSED STEMS
	GO TO 23
11	IF(D.GE.RSTEM)GO TO 12
C  STEMS DOWN
C JUMP IF NO REVERSE NEEDED
	IF(AVERG(K,JJ,LEND).NE.0)GO TO 12
C JUMP IF NOTE LEVELS DO NOT CALL FOR REVERSED STEMS
	JSTM=-1
23	JH=0
	CHNG=0
	N=K
164	R=CODEN(KPN,N,Q,KK)
	IF(Q(KK+2).NE.SN)GO TO 16
	IF(Q(KK+3).GT.B)GO TO 140
	IF(R.NE.1)GO TO 17
	L=5+KK
	IF(Q(L).LT.10)GO TO 16
C  PASS NOTES WITH NO STEM
	R=Q(KK+8)
C  THE STEM LENGTH
	IF(R.EQ.999)R=0
	Q(KK+8)=-R
C  FOR THE INVERSION
19	BC=10.
	A=Q(L)
	IF(A.GE.20)BC=-BC
	Q(L)=BC+A
	IF(JH.NE.0)GO TO 161
C NEXT FOR 1ST NOTE UNDER BEAM
	JH=4
160	R=Q(JJ+JH)-Q(KK+4)
	A=-1 
	IF(JSTM.LT.0)GO TO 163
	A=R
	R=1
C NOW STEMS UP
163	IF(R.GT.A)GO TO 162
C JUMP IF BEAM IS NOT TOO CLOSE TO NOTE
	CHNG=A-R
	IF(JSTM.EQ.0)CHNG=-CHNG
162	IF(L.LT.0)GO TO 141
C  FOR ESCAPE FROM LOOP
161	JH=KK
C  JH SAVES PTR TO LAST NOTE UNDER BEAM
	GO TO 16
17	IF(R.NE.6)GO TO 18
C NOW IT'S A BEAM
	L=7+KK
	CALL BMHGT(Q(KK+4),Q(KK+5),KK)
	GO TO 19
18	IF(R.NE.5)GO TO 16
C NOW IT'S A SLUR
	C=-4
	IF(Q(KK+8).LT.-1)C=-1.8
	IF(Q(KK+7).LT.0)C=-C
	CALL SLRV(KK,C)
C  TO REVERSE SLUR
16	N=N+1
	IF(N.LE.LEND)GO TO 164
C  SHOULD ALWAYS EXIT FROM LOOP BEFORE END OF ARRAY!
140	KK=JH
	L=-1
	JH=5
C GO BACK TO CHECK HGT OF LAST NOTE AND RIGHT END OF BEAM
	GO TO 160

141	IF(CHNG.EQ.0)GO TO 14
	C=CHNG
	IF(CHNG.LT.0)CHNG=-CHNG
	DO 142 N=K,LEND
C  TO READJUST STEMS UNDER REVERSED BEAMS
	R=CODEN(KPN,N,Q,KK)
	IF(Q(KK+2).NE.SN)GO TO 142
	IF(Q(KK+3).GT.B)GO TO 14
C  THE STEM LENGTH
242	IF(R.NE.6)GO TO 142
	Q(KK+4)=Q(KK+4)+C
	Q(KK+5)=Q(KK+5)+C
142	CONTINUE
	GO TO 14

C NEXT FOR SLURS
9	B=-4
	IF(Q(JJ+8).LT.-1)B=-1.8
	IF(Q(JJ+7).LT.0)GO TO 24
	IF(D.GT.RSTEM)GO TO 10
C JUMP TO LEAVE STEM UP
	GO TO 25
24	IF(D.LT.5)GO TO 10
C JUMP TO LEAVE STEM DOWN
	B=-B
25	CALL SLRV(JJ,B)
	GO TO 10
12	DO 13 N=K+1,LEND
	KK=KPN(N)
	IF(Q(KK+2).NE.SN)GO TO 13
C  IS THIS NEEDED↑↑↑↑??
	IF(Q(KK+3).GT.B)GO TO 14
	IF(Q(KK+1).EQ.6.)CALL BMHGT(Q(KK+4),Q(KK+5),KK)
13	CONTINUE
C  JUMP OUT WHEN PAST END OF BEAM.
14	IF(N.GT.K)K=N-1
C          ↑↑↑↑↑↑   WHY????????????
	GO TO 10

2	IF(R.NE.6)GO TO 21
22	JJ=J
	RR=R
	GO TO 20
21	IF(R.EQ.5)GO TO 22

C3/81  10	IF(R.NE.1)GO TO 202
10	IF(Q(J+1).NE.1.)GO TO 202
C***** SOMEHOW GOT HERE WHEN Q(J+1).NE.R !!!!
C NEXT FIXES STEM LENGTHS
	B=0
	A=AMOD(Q(J+4),100.0)
	IF(A.GE.80)A=A-100.
C A=HEIGHT OF NOTE
	IF(Q(J+5).GE.20.)GO TO 302
C JUMP IF STEMS ARE DOWN
	IF(A.LT.0)B=-A     
C LENGTHEN STEM IF NOTE IS TOO FAR BELOW STAFF
	GO TO 402
302	IF(A.GT.14)B=A-14.
402	Q(J+8)=B

202	IF(K.GT.LEND)GO TO 102
	K=K+1
	GO TO 1
102	KW=KW+1
	IF(KW.LT.JPG)GO TO 100
	END

CZZ	FUNCTION NORVRS(R)
CZZ	COMMON /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,IRV,ITR
CZZ	NORVRS=0
CZZ	IF(R.LT.20)GO TO 1
C NOW STEM UP
CZZ	IF(IRV)RETURN
CZZ2	NORVRS=-1
CZZ	RETURN
CZZ1	IF(IRV)GO TO 2
CZZ	END

	SUBROUTINE BMHGT(BBB,C,JJ)
	COMMON /Q/Q(1)
	BB=0 
	B=BBB
	IF(ABS(B).LT.80)GO TO 1
C JUMP IF NOT MINI-BEAM
	BB=B-100.
	IF(B.LT.0)BB=B+100.
	B=BB
1	BC=ABS(Q(JJ+7))
	IF(BC.GE.20.)GO TO 121
	IF(B.GE.0.AND.C.GE.0)RETURN
C NEXT TO CHANGE HGT. OF BEAMS TOO HIGH OR TOO LOW.
	BC=-C
	IF(B.LT.C)BC=-B
C -B IF C IS LOWEST
C3/81 122	IF(BB.NE.0)B=B+100.
122	Q(JJ+4)=BBB+BC
	Q(JJ+5)=C+BC
C BOTH SIDES ARE NOW SHIFTED
	RETURN    
121	IF(B.LE.14.AND.C.LE.14)RETURN
C NOW AT LEAST ONE SIDE IS TOO HIGH
	BC=14-C
	IF(B.GT.C)BC=14-B
	GO TO 122
	END

	SUBROUTINE CUES
	COMMON /PX/KPN(1)/XRN/RN(1)/PTR/KWDS(1)/RCLF/KK,CLEF,KW,ITEM
	1 /LLL/LLL /Q/Q(1)
 
	DO 1 K=LLL,1,-1
C BACK THROUGH ARRAY FROM LAST CUE FOUND.
	IF(CODEN(KPN,K,Q,J).NE.2)GO TO 1
C NEXT FOUND A REST
	IF(Q(J).LT.8)GO TO 1
C JUMP IF WDCNT IS TOO SMALL
	IF(Q(J+10).LT.100)GO TO 1
C P10=100+STAFF NUM. OF CUE DATA.  JUMP IF IMPROPER NUM.
	STF=Q(J+10)-100.
	POS=Q(J+3)
C POSITION OF THIS REST
	PLEFT=0
	PRGHT=1000
C POSITIONS FOR BARS TO LEFT AND RIGHT.  NEXT FIND PROPER BARS.

	DO 2 L=1,ITEM
	IF(CODEN(KWDS,L,RN,N).NE.4)GO TO 2
C FIND A BAR AND ITS POS.
	X=RN(N+3)
	IF(X.GT.POS)GO TO 3
C IS TO LEFT OR RIGHT OF REST?
	IF(X.GT.PLEFT)PLEFT=X
	GO TO 2
3	IF(X.LT.PRGHT)PRGHT=X
2	CONTINUE
C NOW FOUND BARS ON EACH SIDE OF REST.
	
	KLEF=0
	DO 4 L=1,ITEM
C NOW FIND NOTES WITHIN PROPER BAR AND ON PROPER STAFF
	R=CODEN(KWDS,L,RN,N)
	IF(RN(N+2).NE.STF)GO TO 4
	RS=RN(N+3)
C POS. OF ITEM.
	IF(RS.GT.PRGHT)GO TO 4
	IF(RS.LT.PLEFT)GO TO 4
C NOW BETWEEN BARS.
	IF(R.GT.6)GO TO 4
C USE NOTES,RESTS,CLEFS,SLURS,BEAMS
	IF(R.EQ.5) GO TO 44
	RNN=RN(N+4)
	IF(RNN.LT.100)RN(N+4)=RNN+100.
C MAKE ALL NOTES INTO MINIS AND PUT ON STAFF 0
44	RN(N+2)=0
	IF(R.NE.3)GO TO 55
C IS IT A CODE 3?  CHANGE NON-CLEFS TO CODE 33.
	IF(RN(N+5).LT.6)GO TO 66
C JUMP FOR REAL CLEF
	RN(N+1)=33
	GO TO 55
66	RN(N+4)=100
C ALWAYS MINI-CLEF IN CUES.
	KLEF=N
	ITX=L
55	IF(R.GT.2)GO TO 5
	JJ=N+11-R*2.0
	RN(JJ)=RN(JJ)/2.
C JJ=9 OR 7. CUT RHYTH VALS OF CUES 1/2 - SO THEY WILL OCCUPY LESS SPACE.
5	CALL QRN(N,KPN,L)
C GO PUT IT INTO Q ARRAY 
4	CONTINUE

	IF(KLEF.EQ.0)GO TO 6
C NOW REPLACE ORIGINAL CLEF
	R=RN(KLEF+5)
	IF(RN(KLEF).LE.2.)R=0
	IF(R.EQ.CLEF)GO TO 6
	RN(KLEF+5)=CLEF
C	RN(KLEF)=5
	RN(KLEF+3)=PRGHT-1.
	CALL QRN(KLEF,KPN,ITX)
C SHIFT THE WHOLE REST A BIT TO THE RIGHT.
6	Q(J+10)=0
	Q(J+4)=5.
C PUT IT ABOVE STAFF.
	Q(J+5)=-2
C P5=-2=WHOLE REST
	Q(J+9)=0
	Q(J+7)=-1.
C  NEG. RHYTHM MAKES REST IGNORED BY ALL JUSTIFYING ROUTINES.
1	CONTINUE
	END